home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0034_Sampling with Blaster.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  4KB  |  167 lines
  1. {
  2. RYNHARDT HAARHOFF
  3.  
  4. > Help!!! Does anyone have and source code for sampling through the
  5. > Sound Blaster??? Its to do with my 'A' Level Project!!!!
  6.  
  7. the following is a small program using "realtime" sampling. If you would
  8. rather use the CT-VOICE driver then please tell me so.
  9.  
  10. PLEASE NOTE: this was written for a VGA screen, and it uses direct video
  11. memory access in 320x200 mode. If you have any problems with the screen, then
  12. revert back to the BGI, and replace PutDot with PutPixel. It will be slightly
  13. slower then :-(
  14. I have an SB PRO, so I can't guarantee it will work on any other SB, or
  15. on any other system. Use at own risk :-)
  16. }
  17.  
  18. Program VoiceScope;
  19.  
  20. uses
  21.   Crt;
  22.  
  23. const
  24.   ResetPort    = $226;
  25.   CommandPort  = $22C;
  26.   ReadPort     = $22A;
  27.   PollPort     = $22E;
  28.   MaxOldDots   = 50000;  {max size of the array}
  29.   MixerRegPort = $224;   {Volume : Hi nibble = left, Lo Nibble = right}
  30.   MixerDatPort = $225;
  31.   Master       = 35;
  32.   Line         = 46;
  33.   VOC          = 21;
  34.   FM           = 23;     {Hi nibble = FM channel; Lo nibble = volume}
  35.   CD           = 25;
  36.   Mic          = 27;
  37.   ADCChannel   = 29;
  38.   StereoSell   = 31;     {0,1 = mono; 2,3 = stereo}
  39.  
  40.  
  41. var
  42.   Scr       : array [0..199, 0..319] of byte absolute $A000:0000;
  43.   Ch        : char;
  44.   XInt,
  45.   XWidth,
  46.   XMax,
  47.   YMax,
  48.   XMid,
  49.   YMid,
  50.   MaxHeight,
  51.   XStart,
  52.   Color,
  53.   ColorBack : integer;
  54.   OldDots   : array [0..MaxOldDots] of byte;     {to store old dots}
  55.  
  56.  
  57. Procedure InitVideo(Mode : byte; Clr : boolean);
  58. begin
  59.   if NOT Clr then
  60.     Mode := Mode + 128;
  61.   ASM
  62.     mov AH, 00
  63.     mov AL, Mode
  64.     int 10h
  65.   end;
  66. end;
  67.  
  68. Procedure PutDot(x, y : word; Color : byte);
  69. begin
  70.   Scr[y, x] := Color;
  71. end;
  72.  
  73. Procedure SquareFill(x1, y1, x2, y2 : word; Color : byte);
  74. var
  75.   y : word;
  76. begin
  77.   for y := y1 to y2 do
  78.     FillChar(Scr[y, x1], x2-x1, Color);
  79. end;
  80.  
  81. Procedure SetMixer(PortNum, Vol : byte);  {Set mixer ports}
  82. begin
  83.   asm
  84.     MOV DX, MixerRegPort       {Select register port}
  85.     MOV AL, PortNum            {Select which channel}
  86.     OUT DX, AL
  87.     MOV DX, MixerDatPort       {Select data port}
  88.     MOV AL, Vol                {Write volume/data}
  89.     OUT DX, AL
  90.   end;
  91. end;
  92.  
  93. Function ResetSB : boolean;      {resets the SB}
  94. begin
  95.   Port[ResetPort] := 1;
  96.   Delay(1);
  97.   Port[ResetPort] := 0;
  98.   Delay(1);
  99.   if Port[PollPort] and 128 = 128 then
  100.     ResetSB := True
  101.   else
  102.     ResetSB := False;
  103. end;
  104.  
  105. Procedure ShowDots(D : integer);   {show the voice data}
  106. var
  107.   x, y : word;
  108.   NewX : word;
  109. begin
  110.   for x := 1 to XWidth * d do
  111.   begin
  112.     port[CommandPort] := $20;                     { these three lines }
  113.     repeat until (port[PollPort] and 128 = 128);  { gets the actual   }
  114.     y := port[ReadPort];                          { data from the SB  }
  115.  
  116.     if y > 128 + MaxHeight then
  117.       y := 128 + MaxHeight;
  118.     if y < 128 - MaxHeight then
  119.       y := 128 - MaxHeight;
  120.  
  121.     NewX := x div d;
  122.     PutDot(NewX + XStart, OldDots[x] + YMid - 128, ColorBack);
  123.     PutDot(NewX + XStart, y + YMid - 128, y div 2);
  124.     OldDots[x] := y;
  125.   end;
  126.   if keypressed then
  127.   begin    {pause}
  128.     Ch := ReadKey;
  129.     if Ch = #32 then
  130.       repeat until keypressed;
  131.   end;
  132. end;
  133.  
  134. Procedure Init;    {initialize all the variables}
  135. var
  136.   N : longint;
  137. begin
  138.   InitVideo($13, TRUE);
  139.   Ch        := #0;
  140.   XMax      := 319;
  141.   XMid      := XMax div 2;
  142.   YMax      := 199;
  143.   YMid      := YMax div 2;
  144.   XInt      := 10;
  145.   XWidth    := 280;
  146.   XStart    := XMid - XWidth div 2;
  147.   MaxHeight := 60;
  148.   Color     := 9;
  149.   ColorBack := 0;
  150.   SquareFill(XStart-10, YMid-MaxHeight-1-10, XStart+XWidth+1+10, YMid+MaxHeight+1+10, 10);
  151.   SquareFill(XStart, YMid-MaxHeight-1, XStart+XWidth+1, YMid+MaxHeight+1, ColorBack);
  152.   for N := 0 to MaxOldDots do
  153.     OldDots[N] := 128;
  154.   if ResetSb then;
  155. end;
  156.  
  157. BEGIN
  158.   Init;
  159.   SetMixer(ADCChannel, 1);   {Sets the ADC channel to MIC}
  160.  
  161.   {NOTE: I don't know if the mixer routines will work on any other
  162.          SB. If something stalls, then exclude the mixer statements
  163.          If you want to use the LINE-IN, then SetMixer(ADCChannel, 6);}
  164.  
  165.   While Ch <> #27 do ShowDots(1);    {This value is a time constant}
  166. END.
  167.